home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d13 / ptv2n1.arc / WC.PAS < prev   
Pascal/Delphi Source File  |  1991-03-26  |  2KB  |  95 lines
  1.  
  2. Program WC;
  3.  
  4. USES
  5. { Turbo Power Object Professional units }
  6.   OpDos,
  7.   OpString;
  8.  
  9. CONST
  10.   BlockSize = 61440;
  11.  
  12. TYPE
  13.   BlockType  = array [1 .. BlockSize] of char;
  14.  
  15. VAR
  16.   FileName     : string;
  17.   Block        : BlockType;
  18.   ReadFile     : file;
  19.   Fsize,
  20.   Fpos         : longint;
  21.   NumRead      : word;
  22.  
  23.   WordCount    : longint;
  24.   Loop         : longint;
  25.  
  26.   Ch           : char;
  27.   CharFlag     : boolean;
  28.   PredCharFlag : boolean;
  29.   CommentCtr   : integer;
  30.  
  31. BEGIN
  32.   writeln ('WC 1.0, word counter, written by David Gerrold');
  33.  
  34.   if ParamCount <> 1 then begin
  35.     writeln ('USAGE:  WC <filename>');
  36.     halt;
  37.     end;
  38.  
  39.   FileName := StUpCase (ParamStr (1));
  40.   if not ExistFile (FileName) then begin
  41.     writeln ('Sorry, can''t find ''', FileName, '''.');
  42.     halt;
  43.     end;
  44.  
  45.   assign (ReadFile, Filename);
  46.   reset (ReadFile, 1);
  47.   Fsize := filesize (ReadFile);
  48.   WriteLn ('Estimated word count:  ',
  49.            trim (LongIntForm ('###,###,###', Fsize div 6)));
  50.  
  51.   WordCount   := 0;
  52.   Fpos        := 0;
  53.   CommentCtr  := 0;
  54.  
  55.   while
  56.     Fpos < Fsize
  57.   do begin
  58.     BlockRead(ReadFile,Block,sizeof(BlockType),NumRead);
  59.     write ('.');
  60.     Loop := 0;
  61.  
  62.     repeat
  63.       inc (Loop);
  64.       inc (Fpos);
  65.       PredCharFlag := CharFlag;
  66.  
  67.       Ch := Block [Loop];
  68.       CharFlag :=
  69.         ((Ch >= 'a') and (Ch <= 'z')) or
  70.         ((Ch >= 'A') and (Ch <= 'Z')) or
  71.         ((Ch >= '0') and (Ch <= '9')) or
  72.         (Ch = #39);
  73.  
  74.       if CommentCtr = 0 then
  75.         if
  76.           not CharFlag and
  77.           PredCharFlag
  78.         then
  79.           inc (WordCount);
  80.  
  81.       Case Block [Loop] of
  82.         ^N : if CommentCtr > 0 then dec (CommentCtr);
  83.         ^O : inc (CommentCtr);
  84.         end;
  85.     until
  86.       (Loop > BlockSize) or
  87.       (Fpos >= Fsize);
  88.     end;
  89.  
  90.   Close (ReadFile);
  91.   writeln;
  92.   writeln ('Total words in file:  ',
  93.            trim (LongIntForm ('###,###,###', WordCount)));
  94. END.
  95.